home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-20
/
nrd33.zip
/
NRD.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-05-19
|
93KB
|
3,086 lines
{$I-}
{$V-}
{$M 60000,0,655360}
{ ROUTINE: N R D
PURPOSE: Control an NRD525 / NRD535 Receiver + database
USAGE: nrd
AUTHOR: Tom Whiteside 11505 Oak View, Austin, TX 78759 (512) 258-5924
REVISION: 1.0 04-30-90 TGW Initial Release
1.1 07-07-90 TGW Serial routines changed to use BIOS for
Windows
1.2 07-15-90 TGW Efficiency tweaks to inc/dec bw/mode
Cursor Highlighting for current line
Cursor tracking data for inc/dec freq
1.3 07-29-90 TGW Remove H(ide from prompt, fix Delete
leaving wrong line highlighted
Added Revision to prompt
1.4 09-03-90 TGW Fixed inc/dec mode past boundary crashing
program; asserted black backgrd on
title and journal
1.5 09-29-90 TGW Added MAP feature
1.6 11-18-90 TGW Fixed 2 bugs where cursor got out of
sync with "status line"
2.0 12/01-90 TGW Mods to support other com ports, optional
MAP, help easier for o
2.1 12-02-90 TGW Added time offset to config.dat; fixed
home not putting cursor at top of screen
2.2 12-25-90 TGW Added "Com 0" feature to allow using prgm
without serial port...
2.3 12-27-90 TGW Fix to eliminate hang if radio off
2.4 03-02-91 TGW Fix for monochrome users (in screen.pas)
2.5 03-10-91 TGW Added Import of Sundstrom data
2.6 03-30-91 TGW Added Active and Inactive log concept
including write from the inactive log
Added "*" command to find radio freq
in database. Fixed potential hang in
comreadln. Reduced edit field length
for comments by 1 char. (Fixed wrap bug
for bottom line) Removed dangerous Read
command from Journal
2.7 04-14-91 TGW Fixed display bug in inc_freq
3.0 04-26-91 TGW Added NRD535 features
3.1 04-27-91 TGW Fix to journal name select; Added 535
mode to auto-update receiver display
3.2 05-12-91 TGW Added S-meter to 535; changed mode order
to AM -> ECSS_U; added graphics command
for 535; misc bug fixes for 535
3.2 05-19-91 TGW Graphics enhancements; commands for time
and spectral displays. Performance
enhancement to Spectral display
}
program nrd(input,output);
uses async, crt, dos, graph, screen, nrdio, nrdutil;
const LINES = 25;
CHARPERLINE = 80;
BACKTAB = chr(10);
TAB = chr(9);
PAGEUP = chr(3);
PAGEDOWN = chr(4);
UP = chr(15);
DOWN = chr(11);
RIGHTARROW = chr(21);
LEFTARROW = chr(7);
CTRLPAGEUP = chr(14);
CTRLPAGEDN = chr(16);
HOMEKY = chr(5);
ENDKY = chr(6);
REMOTE_DLY = 300; { msec }
MAP_OFFSET = 2.0; { frequency offset from center for sync det. }
var i,cnt: integer;
ch:char;
s:string;
oldstat:receivertype;
logbuf:file;
logentry:logtype;
min_mark,max_mark:word;
rslt:integer;
display_page:integer;
update_receiver_display:boolean;
displayed_freq:array[1..LINES] of real;
displayed_lines:integer;
map:boolean;
last_log:integer; { used for hot keying between active and last log }
last_log_data:logtype; { used to copy data from last log to active log }
old_time_stamp, time_stamp:word;
enable_s_meter:boolean;
meter_reading:integer;
graphmode:integer;
procedure status_window;
begin
window(1,25,80,25);
gotoxy(1,1);
writea(BLACK,BACKGROUND);
writea(LIGHTGRAY, FOREGROUND);
write(output,'Active Log: ');
writea(CYAN, FOREGROUND);
write(output,loglist.log[loglist.currentlog].logname);
if last_log <> 0 then
begin
writea(LIGHTGRAY, FOREGROUND);
write(output,' Inactive Log: ');
writea(CYAN, FOREGROUND);
write(output,loglist.log[last_log].logname);
end;
end;
procedure clear_log(var logdata:logtype);
const GMTCONST = 6; { bug: must manually update with time change }
var dy,yr,mo,dyofweek,hour,minute,sec,sec100:word;
t:string;
begin
getdate(yr,mo,dy,dyofweek);
gettime(hour,minute,sec,sec100);
hour:=hour + gmt_offset;
if hour >= 24 then
begin
hour:=hour - 24;
dy:=dy + 1;
if dy > 31 then { kludge date, doesn't allow for 30 day mo, etc }
begin
dy:=1;
mo:=mo + 1;
if mo > 12 then mo:=1;
end;
end;
with logdata do
begin
{init date to today's date in yymmdd format }
str(yr,t); delete(t,1,2);
date:=t;
str(mo,t);
if length(t) < 2 then t:=concat('0',t);
date:=concat(date,t);
str(dy,t);
if length(t) < 2 then t:=concat('0',t);
date:=concat(date,t);
{ init time in gmt }
str(hour,t);
while length(t) < 2 do t:=concat('0',t);
begin_time:=t;
str(minute,t);
while length(t) < 2 do t:=concat('0',t);
begin_time:=concat(begin_time,t);
end_time:=begin_time;
frequency:= receiverstat.frequency;
callsign:= '';
location:= '';
comment:= '';
mode:= receiverstat.mode;
bandwidth:= receiverstat.bandwidth;
agc:= receiverstat.agc;
attenuator:=receiverstat.attenuator;
end;
end;
procedure draw_display_titles;
begin
top_window;
gotoxy(1,5);
clreol;
case display_page of
1: begin
gotoxy(2,5);
write(output,'Num');
gotoxy(7,5);
write(output,'Date');
gotoxy(13,5);
write(output,'Strt');
gotoxy(18,5);
write(output,'End');
gotoxy(24,5);
write(output,'Freq');
gotoxy(32,5);
write(output,'Station ID');
gotoxy(52,5);
write(output,'Location');
end;
2: begin
gotoxy(3,5);
write(output,'Freq');
gotoxy(11,5);
write(output,'Comment');
end;
3: begin
gotoxy(2,5);
write(output,'Num');
gotoxy(7,5);
write(output,'Date');
gotoxy(13,5);
write(output,'Strt');
gotoxy(18,5);
write(output,'End');
gotoxy(24,5);
write(output,'Freq');
gotoxy(32,5);
write(output,'Mode');
gotoxy(39,5);
write(output,'BW');
gotoxy(43,5);
write(output,'AGC');
gotoxy(48,5);
write(output,'Attn');
end;
end;
end;
procedure init_rec_window;
procedure draw_box(width,hieght:integer);
const TL = chr(201);
TR = chr(187);
BL = chr(200);
BR = chr(188);
HZ = chr(205);
VT = chr(186);
var i:integer;
procedure draw_horiz;
var i:integer;
begin
for i:=1 to width - 2 do write(output,HZ);
end;
begin
{ draw top }
gotoxy(1,2);
write(output,TL);
draw_horiz;
write(output,TR);
{ draw sides }
for i:=1 to hieght - 2 do
begin
gotoxy(1,i + 2); write(output,VT);
gotoxy(width, i + 2); write(output,VT);
end;
{ draw bottom }
gotoxy(1,hieght + 1);
write(output,BL);
draw_horiz;
write(output,BR);
end;
begin
top_window;
writea(BLACK,BACKGROUND);
home;
cmd_prompt(prompt_num);
writea(BROWN,FOREGROUND);
draw_box(REC_WIN_X_BOTTOM - REC_WIN_X_TOP + 1,
REC_WIN_Y_BOTTOM - REC_WIN_Y_TOP - 1) ;
gotoxy(30,2);
writea(LIGHTGRAY,FOREGROUND);
if radio_type = 525
then write(output,'NRD 525 Status')
else write(output,'NRD 535 Status');
gotoxy(3,3);
write(output,'Mode:');
gotoxy(15,3);
write(output,'BW:');
gotoxy(29,3);
write(output,'AGC:');
if radio_type = 525 then
begin
gotoxy(42,3);
write(output,'Ch:');
end;
gotoxy(54,3);
write(output,'Freq:');
gotoxy(68,3);
write(output,' khz');
display_page:=1;
writea(LIGHTGRAY,FOREGROUND);
draw_display_titles;
writea(LIGHTGRAY,FOREGROUND);
end;
procedure show_receiver;
var s:string;
procedure do_out(unchanged:boolean; s:string);
begin
if not unchanged then writea(RED,FOREGROUND);
write(output,s);
writea(CYAN,FOREGROUND);
end;
begin
x_pos:=wherex; y_pos:=wherey;
top_window;
writea(CYAN,FOREGROUND);
with receiverstat do
begin
gotoxy(9,3);
case mode of
RTTY: s:='RTTY ';
CW: s:='CW ';
USB: s:='USB ';
LSB: s:='LSB ';
AM: s:='AM ';
FM: s:='FM ';
FAX: s:='FAX ';
ECSS_USB: s:='ECSSu';
ECSS_LSB: s:='ECSSl';
end;
do_out(receiverstat.mode = oldstat.mode,s);
gotoxy(19,3);
case bandwidth of
WIDE: s:='WIDE ';
INTER:s:='INTER';
NARR: s:='NARR ';
AUX: s:='AUX ';
end;
do_out(receiverstat.bandwidth = oldstat.bandwidth,s);
gotoxy(34,3);
case agc of
SLOW: s:='SLOW';
FAST: s:='FAST';
OFF: s:='OFF ';
end;
do_out(receiverstat.agc = oldstat.agc,s);
case attenuator of
YES: s:='ATT';
NO: s:=' ';
end;
gotoxy(74,3);
do_out(receiverstat.attenuator = oldstat.attenuator,s);
if radio_type = 525 then
begin
gotoxy(46,3);
str(channel:3,s);
do_out(receiverstat.channel = oldstat.channel,s);
end;
gotoxy(60,3);
str(frequency:8:2,s);
do_out(receiverstat.frequency = oldstat.frequency,s);
gotoxy(78,3);
if map then write(output,'K') else write(output,' ');
writea(LIGHTGRAY,FOREGROUND);
end;
bottom_window;
oldstat:=receiverstat;
gotoxy(x_pos,y_pos);
end;
procedure program_radio(log_entry:logtype);
{ set receiver to log entry; side effect - zaps channel 199 on 535 }
begin
remote_on;
if radio_type = 535 then
with log_entry do
set_all(199,attenuator,bandwidth,mode,frequency,agc)
else
begin
if map then {force to AM}
begin
set_freq(log_entry.frequency + MAP_OFFSET);
set_mode(AM);
set_bandwidth(WIDE);
set_agc(FAST);
end
else {use log entry}
begin
set_freq(log_entry.frequency);
if (radio_type = 525) and (log_entry.mode in [ECSS_USB,ECSS_LSB])
then log_entry.mode:=AM;
set_mode(log_entry.mode);
set_bandwidth(log_entry.bandwidth);
set_agc(log_entry.agc);
end;
set_attenuator(log_entry.attenuator);
end;
remote_off(REMOTE_DLY);
update_receiver_display:=TRUE;
end;
function mode_to_str(mode:modetype):short_str;
var s:short_str;
begin
case mode of
RTTY: s:='RTTY';
CW: s:=' CW';
USB: s:='USB';
LSB: s:='LSB';
AM: s:=' AM';
FM: s:=' FM';
FAX: s:='FAX';
ECSS_USB: s:='ECSSu';
ECSS_LSB: s:='ECSSl';
end;
mode_to_str:=s;
end;
function bandwidth_to_str(bandwidth:bandwidthtype):short_str;
var s:short_str;
begin
case bandwidth of
NARR: s:=' NARR';
INTER: s:='INTER';
WIDE: s:=' WIDE';
AUX: s:=' AUX';
end;
bandwidth_to_str:=s;
end;
procedure show_log_line(logdata:logtype;rec,i:word);
procedure show_line1;
begin
write(output,rec:4);
with logdata do
begin
gotoxy(6,i);
write(output,date);
gotoxy(13,i);
write(output,begin_time);
gotoxy(18,i);
write(output,end_time);
gotoxy(23,i);
write(output,frequency:8:2);
gotoxy(32,i);
write(output,callsign);
gotoxy(52,i);
write(output,location);
end;
end;
procedure show_line2;
begin
with logdata do
begin
gotoxy(2,i);
write(output,frequency:8:2);
gotoxy(11,i);
write(output,comment);
end;
end;
procedure show_line3;
var s:short_str;
begin
write(output,rec:4);
with logdata do
begin
gotoxy(6,i);
write(output,date);
gotoxy(13,i);
write(output,begin_time);
gotoxy(18,i);
write(output,end_time);
gotoxy(23,i);
write(output,frequency:8:2);
gotoxy(32,i);
s:=mode_to_str(mode);
write(output,s);
gotoxy(37,i);
s:=bandwidth_to_str(bandwidth);
write(output,s);
gotoxy(43,i);
case agc of
FAST: write(output,'FAST');
SLOW: write(output,'SLOW');
OFF: write(output,' OFF');
end;
gotoxy(49,i);
case attenuator of
YES: write(output,'ON');
NO: write(output,'OFF');
end;
end;
end;
begin
gotoxy(1,i); clreol;
case display_page of
1: show_line1;
2: show_line2;
3: show_line3;
end;
end;
function precess(var rec:integer; cnt:integer):boolean;
{ skip cnt displayed records; return TRUE is not past eof }
var i:integer;
begin
for i:=1 to cnt do
begin
rec:=rec + 1;
while (rec < records)
and (recdata.recstat[recdata.recptr[rec]] <> SHOW) do
rec:=rec + 1;
end;
if rec > records then rec:=records;
precess:=recdata.recstat[recdata.recptr[rec]] = SHOW;
end;
procedure sync_loglist;
var dummy:boolean;
i,y_pos:integer;
recnum:integer;
begin
y_pos:=wherey;
i:=loglist.currentlog;
loglist.log[i].records:=records;
recnum:=rec - 1;
dummy:=precess(recnum,y_pos);
loglist.log[i].rec:=recnum;
put_loglist(loglist);
end;
procedure show_log(rec:integer; refresh_screen,highlight:boolean);
{ refresh_screen = TRUE; paint entire screen with log entries
= FALSE then highlight line if indicated }
var i,j,x_temp,y_temp:integer;
logdata:logtype;
begin
writea(CYAN,FOREGROUND); writea(BLACK,BACKGROUND);
i:=0; j:=rec - 1;
y_temp:=wherey; { used to highlight cursor line }
x_temp:=wherex;
if refresh_screen then home;
while (i < LINES - REC_WIN_Y_BOTTOM - 1) and (j < records) do
begin
inc(i);
if precess(j,1) then
begin
get_log(logbuf,logdata,recdata.recptr[j]);
displayed_freq[i]:=logdata.frequency;
if (j >= min_mark) and (j <= max_mark) then
begin
writea(BLACK,FOREGROUND);
writea(YELLOW,BACKGROUND);
show_log_line(logdata,j,i);
writea(BLACK,BACKGROUND);
writea(CYAN,FOREGROUND);
end
else if (i = y_temp) and highlight then
begin
writea(BLACK,FOREGROUND);
writea(CYAN,BACKGROUND);
show_log_line(logdata,j,i);
writea(BLACK,BACKGROUND);
writea(CYAN,FOREGROUND);
end
else if refresh_screen or ((i = y_temp) and not highlight)
then show_log_line(logdata,j,i);
end;
end;
displayed_lines:=i;
gotoxy(x_temp,y_temp);
end;
procedure do_mark;
var recnum:integer;
dummy:boolean;
begin
x_pos:=wherex; y_pos:=wherey;
recnum:=rec - 1;
dummy:=precess(recnum,y_pos);
if recnum < min_mark then min_mark:=recnum;
if recnum > max_mark then max_mark:=recnum;
show_log(rec,TRUE,TRUE);
end;
procedure do_unmark(display:boolean);
begin
x_pos:=wherex; y_pos:=wherey;
max_mark:=0;
min_mark:=MAXREC + 1;
if display then show_log(rec,TRUE,TRUE);
end;
procedure do_undelete;
var t,recnum:integer;
x_pos,y_pos:integer;
dummy:boolean;
i,j:integer;
ch:char;
begin
write_prompt('uNdelete: Type "y" to continue');
ch:=upcase(fetch);
cmd_prompt(prompt_num);
bottom_window;
if ch <> 'Y' then exit;
x_pos:=wherex; y_pos:=wherey;
recnum:=rec - 1;
dummy:=precess(recnum,y_pos);
i:=records;
while (i > 1) and (recdata.recstat[recdata.recptr[i]] <> DELETED)
do i:=i - 1;
if recdata.recstat[recdata.recptr[i]] = DELETED then { found one }
begin
t:=recdata.recptr[i];
recdata.recstat[t]:=SHOW;
for j:=i downto recnum + 1 do
recdata.recptr[j]:=recdata.recptr[j - 1];
recdata.recptr[recnum]:=t;
put_recdata(loglist.currentlog,recdata);
show_log(rec,TRUE,TRUE);
end;
end;
procedure do_sort(auto:boolean);
var sortdata:sort_array_type;
subsortdata:sort_array_type;
primary,secondary:char;
function get_sort_type(auto:boolean; var primary, secondary:char):boolean;
begin
if auto then { automatically do Frequency, Time sort }
begin
get_sort_type:=TRUE;
primary:='F';
secondary:='T';
exit;
end;
repeat
write_prompt('Sort - Primary field: D(ate, T(ime, F(req, C(all,'
+' L(oc, M(ode, Q(uit');
primary:=upcase(fetch);
until primary in ['D','T','F','C','L','M','Q'];
if primary <> 'Q' then
repeat
write_prompt('Sort - Secondary field: D(ate, T(ime, F(req, C(all,'
+' L(oc, M(ode, Q(uit');
secondary:=upcase(fetch);
until secondary in ['D','T','F','C','L','M','Q'];
cmd_prompt(prompt_num);
bottom_window;
get_sort_type:=(primary <> 'Q') and (secondary <> 'Q');
end;
procedure get_fields;
var i:integer;
logdata:logtype;
procedure init_array(var sortdata:short_str; cmd:char);
begin
case cmd of
'D':sortdata:=copy(logdata.date,1,SHORTSTRLEN);
'T':sortdata:=copy(logdata.begin_time,1,SHORTSTRLEN);
'F':str(logdata.frequency:8:1,sortdata);
'C':sortdata:=copy(logdata.callsign,1,SHORTSTRLEN);
'L':sortdata:=copy(logdata.location,1,SHORTSTRLEN);
'M':case logdata.mode of
RTTY:sortdata:='RTTY';
CW :sortdata:='CW';
USB :sortdata:='USB';
LSB :sortdata:='LSB';
AM :sortdata:='AM';
FM :sortdata:='FM';
FAX :sortdata:='FAX';
end;
end;
end;
begin
home;
for i:=1 to records do
begin
if recdata.recstat[i] = DELETED then { dummy sort pos }
begin
sortdata[i]:=chr(255);
subsortdata[i]:=chr(255);
end
else
begin
get_log(logbuf,logdata,i);
init_array(sortdata[i],primary);
init_array(subsortdata[i],secondary);
end;
recdata.recptr[i]:=i;
end;
end;
procedure primary_sort; { sort on primary field }
begin
write(output,'Primary sort');
sort(sortdata,recdata.recptr,1,records);
end;
procedure secondary_sort; { sort on secondary field }
var i,top:integer;
tempstr:string;
begin
top:=1; home;
write(output,'Secondary sort');
while (top < records) do
begin
i:=0;
tempstr:=sortdata[top];
while (top + i < records) and (tempstr = sortdata[top + i]) do
begin
sortdata[top + i]:=subsortdata[recdata.recptr[top + i]];
inc(i);
end;
sort(sortdata,recdata.recptr,top,i);
top:=top + i;
end;
end;
begin
if get_sort_type(auto,primary,secondary) then
begin
get_fields;
primary_sort;
secondary_sort;
end;
show_log(rec,TRUE,TRUE);
put_recdata(loglist.currentlog,recdata);
end;
function upcasestr(s:string):string;
var i:integer;
s1:string;
begin
s1:=s;
for i:=1 to length(s) do s1[i]:=upcase(s[i]);
upcasestr:=s1;
end;
procedure do_page;
begin
x_pos:=wherex; y_pos:=wherey;
display_page:=display_page + 1;
if display_page > 3 then display_page:=1;
draw_display_titles;
bottom_window;
if rslt = 0 then show_log(rec,TRUE,TRUE);
end;
procedure do_tab;
begin
x_pos:=wherex; y_pos:=wherey;
case display_page of
1:begin
if x_pos in [1..5] then x_pos:=6 else
if x_pos in [6..12] then x_pos:=13 else
if x_pos in [13..17] then x_pos:=18 else
if x_pos in [18..22] then x_pos:=23 else
if x_pos in [23..31] then x_pos:=32 else
if x_pos in [32..51] then x_pos:=52 else
begin
x_pos:=11;
gotoxy(x_pos,y_pos);
do_page;
end;
gotoxy(x_pos,y_pos);
end;
2:begin
x_pos:=32;
gotoxy(x_pos,y_pos);
do_page;
end;
3:begin
if x_pos in [1..5] then x_pos:=6 else
if x_pos in [6..12] then x_pos:=13 else
if x_pos in [13..17] then x_pos:=18 else
if x_pos in [18..22] then x_pos:=23 else
if x_pos in [23..31] then x_pos:=32 else
if x_pos in [32..36] then x_pos:=37 else
if x_pos in [37..42] then x_pos:=43 else
if x_pos in [43..48] then x_pos:=49 else
begin
x_pos:=6;
gotoxy(x_pos,y_pos);
do_page;
end;
gotoxy(x_pos,y_pos);
end;
end;
end;
procedure do_backtab;
begin
x_pos:=wherex; y_pos:=wherey;
case display_page of
1:begin
if x_pos in [7..13] then x_pos:=6 else
if x_pos in [14..18] then x_pos:=13 else
if x_pos in [19..23] then x_pos:=18 else
if x_pos in [24..32] then x_pos:=23 else
if x_pos in [33..80] then x_pos:=32 else
begin
x_pos:=38;
gotoxy(x_pos,y_pos);
display_page:=display_page - 2;
do_page;
end;
gotoxy(x_pos,y_pos);
end;
2:begin
if x_pos in [3..10] then x_pos:=2 else
if x_pos in [12..80] then x_pos:=11 else
begin
x_pos:=52;
gotoxy(x_pos,y_pos);
display_page:=display_page - 2;
do_page;
end;
gotoxy(x_pos,y_pos);
end;
3:begin
if x_pos in [7..13] then x_pos:=6 else
if x_pos in [14..18] then x_pos:=13 else
if x_pos in [19..23] then x_pos:=18 else
if x_pos in [24..32] then x_pos:=23 else
if x_pos in [33..37] then x_pos:=32 else
if x_pos in [38..43] then x_pos:=37 else
if x_pos in [44..49] then x_pos:=43 else
if x_pos in [50..80] then x_pos:=49 else
begin
x_pos:=11;
gotoxy(x_pos,y_pos);
display_page:=display_page - 2;
do_page;
end;
gotoxy(x_pos,y_pos);
end;
end;
end;
procedure do_edit; { edit field cursor is on }
var recnum:integer;
logdata:logtype;
s:string;
i,j,y,dummy:integer;
tabkey,backtabkey:boolean;
procedure edit_page1;
begin
case x_pos of
6..12: editfield(5, y,DATELEN,FALSE,tabkey,backtabkey,logdata.date);
13..17: begin
editfield(12,y,TIMELEN,FALSE,tabkey,backtabkey
,logdata.begin_time);
while length(logdata.begin_time) < 4 do
logdata.begin_time:=concat('0',logdata.begin_time);
end;
18..22: begin
editfield(17,y,TIMELEN,FALSE,tabkey,backtabkey
,logdata.end_time);
while length(logdata.end_time) < 4 do
logdata.end_time:=concat('0',logdata.end_time);
end;
23..31: begin
str(logdata.frequency:8:2,s);
editfield(22,y,8,TRUE,tabkey,backtabkey,s);
val(s,logdata.frequency,dummy);
end;
32..51: editfield(31,y,CALLSIGNLEN,FALSE,tabkey,backtabkey
,logdata.callsign);
52..80: editfield(51,y,LOCATIONLEN,FALSE,tabkey,backtabkey
,logdata.location);
end;
end;
procedure edit_page2;
begin
case x_pos of
1..10: begin
str(logdata.frequency:8:2,s);
editfield(1,y,8,TRUE,tabkey,backtabkey,s);
val(s,logdata.frequency,dummy);
end;
11..80: editfield(10,y,COMMENTLEN-1,FALSE,tabkey,backtabkey
,logdata.comment);
end;
end;
procedure edit_page3;
begin
case x_pos of
6..12: editfield(5, y,DATELEN,FALSE,tabkey,backtabkey,logdata.date);
13..17: begin
editfield(12,y,TIMELEN,FALSE,tabkey,backtabkey
,logdata.begin_time);
while length(logdata.begin_time) < 4 do
logdata.begin_time:=concat('0',logdata.begin_time);
end;
18..22: begin
editfield(17,y,TIMELEN,FALSE,tabkey,backtabkey
,logdata.end_time);
while length(logdata.end_time) < 4 do
logdata.end_time:=concat('0',logdata.end_time);
end;
23..31: begin
str(logdata.frequency:8:2,s);
editfield(22,y,8,TRUE,tabkey,backtabkey,s);
val(s,logdata.frequency,dummy);
end;
32..36: begin
case logdata.mode of
RTTY: s:='RTTY';
CW: s:=' CW';
USB: s:='USB';
LSB: s:='LSB';
AM: s:=' AM';
FM: s:=' FM';
FAX: s:='FAX';
end;
editfield(31,y,4,FALSE,tabkey,backtabkey,s);
s:=upcasestr(s);
if pos('RTTY',s) > 0 then logdata.mode:=RTTY else
if pos('CW',s) > 0 then logdata.mode:=CW else
if pos('USB',s) > 0 then logdata.mode:=USB else
if pos('LSB',s) > 0 then logdata.mode:=LSB else
if pos('AM',s) > 0 then logdata.mode:=AM else
if pos('FM',s) > 0 then logdata.mode:=FM else
if pos('FAX',s) > 0 then logdata.mode:=FAX
end;
37..42: begin
case logdata.bandwidth of
NARR: s:=' NARR';
INTER:s:='INTER';
WIDE: s:=' WIDE';
AUX: s:=' AUX';
end;
editfield(36,y,5,FALSE,tabkey,backtabkey,s);
s:=upcasestr(s);
if pos('INTER',s) > 0 then logdata.bandwidth:=INTER else
if pos('NARR',s) > 0 then logdata.bandwidth:=NARR else
if pos('WIDE',s) > 0 then logdata.bandwidth:=WIDE else
if pos('AUX' ,s) > 0 then logdata.bandwidth:=AUX
end;
43..48: begin
case logdata.agc of
FAST: s:='FAST';
SLOW: s:='SLOW';
OFF: s:=' OFF';
end;
editfield(42,y,4,FALSE,tabkey,backtabkey,s);
s:=upcasestr(s);
if pos('FAST',s) > 0 then logdata.agc:=FAST else
if pos('SLOW',s) > 0 then logdata.agc:=SLOW else
if pos('OFF',s) > 0 then logdata.agc:=OFF
end;
49..51: begin
case logdata.attenuator of
YES: s:='ON';
NO: s:='OFF';
end;
editfield(48,y,3,FALSE,tabkey,backtabkey,s);
s:=upcasestr(s);
if pos('OFF',s) > 0 then logdata.attenuator:=NO else
if pos('ON',s) > 0 then logdata.attenuator:=YES
end;
end;
end;
begin { do_edit }
x_pos:=wherex; y_pos:=wherey; y:=y_pos - 1;
recnum:=rec - 1;
if precess(recnum,y_pos) then
begin
get_log(logbuf,logdata,recdata.recptr[recnum]);
case display_page of
1: edit_page1;
2: edit_page2;
3: edit_page3;
end;
put_log(logbuf,logdata,recdata.recptr[recnum]);
if not (tabkey or backtabkey) then
begin
gotoxy(x_pos,y_pos);
show_log(rec,TRUE,TRUE);
end;
end;
gotoxy(x_pos,y_pos);
if tabkey then
begin
do_tab;
do_edit;
end
else if backtabkey then
begin
do_backtab;
do_edit;
end;
end;
procedure do_delete;
var x_pos,y_pos:integer;
recnum:integer;
ch:char;
i,t:integer;
begin
x_pos:=wherex; y_pos:=wherey;
recnum:=rec - 1;
write_prompt('Delete: Type "y" to continue');
ch:=upcase(fetch);
cmd_prompt(prompt_num);
bottom_window;
if ch = 'Y' then if precess(recnum,y_pos) then
begin
t:=recdata.recptr[recnum];
recdata.recstat[t]:=DELETED;
for i:=recnum to records - 1 do with recdata do
recptr[i]:=recptr[i + 1];
recdata.recptr[records]:=t;
show_log(rec,TRUE,TRUE);
put_recdata(loglist.currentlog,recdata);
end;
end;
procedure do_log;
var x_pos,y_pos:integer;
t,recnum:integer;
ch:char;
i,j:integer;
dummy:boolean;
logdata:logtype;
begin
x_pos:=32; y_pos:=wherey;
recnum:=rec - 1;
dummy:=precess(recnum,y_pos);
{ get receiver status }
if radio_type = 525 then remote_on else toggle_remote;
show_receiver;
remote_off(0);
i:=1;
while (i < records) and (recdata.recstat[recdata.recptr[i]] <> DELETED)
do inc(i);
if (i >= records) and (recdata.recstat[recdata.recptr[i]]<>DELETED) then
{ insert new entry here }
begin
inc(records);
i:=records;
recdata.recptr[i]:=i;
loglist.log[loglist.currentlog].records:=records;
put_loglist(loglist);
end;
t:=recdata.recptr[i];
if recnum = 0 then recnum:=1; { special case for new arrays }
for j:=i downto recnum + 1 do with recdata do
recptr[j]:=recptr[j - 1];
recdata.recptr[recnum]:=t;
recdata.recstat[t]:=SHOW;
clear_log(logdata);
with receiverstat do
begin
if map then {center frequency}
begin
logdata.frequency:=trunc(frequency/5.0 + 0.5) * 5;
logdata.mode:=USB;
logdata.bandwidth:=INTER;
end
else
begin
logdata.frequency:=frequency;
logdata.mode:=mode;
logdata.bandwidth:=bandwidth;
end;
logdata.agc:=agc;
logdata.attenuator:=attenuator;
end;
put_log(logbuf,logdata,recdata.recptr[recnum]);
put_recdata(loglist.currentlog,recdata);
if display_page <> 1 then
begin
display_page:=1;
draw_display_titles;
bottom_window;
end;
gotoxy(x_pos,y_pos);
show_log(rec,TRUE,TRUE);
do_edit;
end;
procedure do_tune;
{ assign log entry at cursor location to radio }
var recnum:integer;
logdata:logtype;
begin
y_pos:=wherey;
recnum:=rec - 1;
if precess(recnum, y_pos) then
begin
get_log(logbuf,logdata,recdata.recptr[recnum]);
program_radio(logdata);
if radio_type = 535 then toggle_remote;
end;
end;
function find_rec(rec:integer; freq:real):integer; { find record >= frequency }
var j:integer;
logdata:logtype;
first_try, found:boolean;
begin
j:=rec - 20; { skip back enuf records to find start hopefully }
if j < 0 then j:=0;
found:=FALSE; first_try:=TRUE;
while (j < records) and not found do
begin
if precess(j,1) then
begin
get_log(logbuf,logdata,recdata.recptr[j]);
if first_try and (logdata.frequency > freq)
then j:=0
else found:=logdata.frequency >= freq;
first_try:=FALSE;
end;
end;
find_rec:=j;
end;
procedure inc_freq;
var s:string;
x_pos,y_pos,i:integer;
orig_freq:real;
procedure display(frequency:real); { find displayed line matching freq }
var found,lt:boolean;
j:integer;
begin
j:=0; found:=FALSE; lt:=FALSE;
while (j < LINES - REC_WIN_Y_BOTTOM - 1) and not found do
begin
inc(j);
if frequency > displayed_freq[j] then lt:=TRUE; {condition for fnd}
found:=frequency <= displayed_freq[j];
end;
if found and lt then { found it and its on the screen }
begin
y_pos:=j;
gotoxy(x_pos,y_pos);
show_log(rec,FALSE,TRUE);
end
else { new screen }
begin
rec:=find_rec(rec, frequency);
gotoxy(x_pos,1);
show_log(rec,TRUE,TRUE);
end;
end;
begin {inc_freq}
x_pos:=wherex; y_pos:=wherey;
show_log(rec,FALSE,FALSE); { unhighlight current cursor line }
with receiverstat do
begin
remote_on;
orig_freq:=frequency;
frequency:=trunc(frequency/10.0) * 10.0;
if orig_freq - frequency >= 5.0 then frequency:=frequency + 5.0;
case mode of
USB: set_freq(frequency + 4.0);
LSB: set_freq(frequency + 6.0);
AM:
else
begin
for i:=1 to 4 do
begin
set_freq(frequency + i);
delay(150);
end;
end;
end;
delay(200);
frequency:=frequency + 5.0;
if map then frequency:=frequency + MAP_OFFSET;
set_freq(frequency);
remote_off(0);
if radio_type = 535 then toggle_remote;
show_receiver;
display(frequency);
end;
end;
procedure dec_freq;
var s:string;
x_pos,y_pos,i:integer;
orig_freq:real;
procedure display(frequency:real); { find displayed line matching freq }
var found,lt:boolean;
j:integer;
begin
j:=LINES - REC_WIN_Y_BOTTOM; found:=FALSE; lt:=FALSE;
while (j > 1) and not found do
begin
dec(j);
if frequency < displayed_freq[j] then lt:=TRUE;{condition for fnd}
found:=frequency >= displayed_freq[j];
end;
if found and lt then { found it and its on the screen }
begin
gotoxy(x_pos,j);
show_log(rec,FALSE,TRUE);
end
else { new screen }
begin
rec:=find_rec(rec, frequency);
rec:=rec - LINES + REC_WIN_Y_BOTTOM + 2;
if rec < 1 then rec:=1;
gotoxy(x_pos,1);
show_log(rec,TRUE,TRUE);
show_log(rec,FALSE,FALSE);
y_pos:=0; found:=FALSE;
while not found and (y_pos < LINES - REC_WIN_Y_BOTTOM - 1) do
begin
inc(y_pos);
found:=displayed_freq[y_pos] >=frequency;
end;
gotoxy(x_pos,y_pos);
show_log(rec,FALSE,TRUE);
end;
end;
begin {dec_freq}
x_pos:=wherex; y_pos:=wherey;
show_log(rec,FALSE,FALSE); { unhighlight current cursor line }
with receiverstat do
begin
remote_on;
orig_freq:=frequency;
frequency:=trunc(frequency/10.0) * 10.0;
if orig_freq - frequency > 5.0 then frequency:=frequency + 10.0
else if orig_freq - frequency > 0.0 then frequency:=frequency + 5.0;
case mode of
USB: set_freq(frequency - 6.0);
LSB: set_freq(frequency - 4.0);
AM:
else
begin
for i:=1 to 4 do
begin
set_freq(frequency - i);
delay(150);
end;
end;
end;
delay(200);
frequency:=frequency - 5.0;
if map then frequency:= frequency + MAP_OFFSET;
set_freq(frequency);
remote_off(0);
if radio_type = 535 then toggle_remote;
show_receiver;
display(receiverstat.frequency);
end;
end;
procedure find_freq;
var s:string;
x_pos,y_pos,i:integer;
orig_freq:real;
ch:char;
procedure display(frequency:real); { find displayed line matching freq }
var found:boolean;
begin
rec:=find_rec(1, frequency);
rec:=rec - LINES + REC_WIN_Y_BOTTOM + 2;
if rec < 1 then rec:=1;
gotoxy(x_pos,1);
show_log(rec,TRUE,TRUE);
show_log(rec,FALSE,FALSE);
y_pos:=0; found:=FALSE;
while not found and (y_pos < LINES - REC_WIN_Y_BOTTOM - 1) do
begin
inc(y_pos);
found:=displayed_freq[y_pos] >=frequency;
end;
gotoxy(x_pos,y_pos);
show_log(rec,FALSE,TRUE);
end;
begin {find_freq}
x_pos:=wherex; y_pos:=wherey;
show_log(rec,FALSE,FALSE); { unhighlight current cursor line }
with receiverstat do
begin
if radio_type = 525 then remote_on
else toggle_remote;
remote_off(0);
show_receiver;
display(receiverstat.frequency);
end;
end;
procedure inc_mode;
var x_pos,y_pos:integer;
begin
x_pos:=wherex; y_pos:=wherey;
with receiverstat do
begin
remote_on;
if radio_type = 525 then
begin
if mode < FAX
then mode:=succ(mode)
else mode:=RTTY;
end
else { do special case for nrd535 }
begin
case mode of
RTTY: mode:=CW;
CW: mode:=USB;
USB: mode:=LSB;
LSB: mode:=AM;
AM: mode:=ECSS_USB; { change order }
ECSS_USB: mode:=ECSS_LSB;
ECSS_LSB: mode:=FM;
FM: mode:=FAX;
FAX: mode:=RTTY;
end;
end;
set_mode(mode);
remote_off(REMOTE_DLY + 100);
if radio_type = 535 then toggle_remote;
show_receiver;
gotoxy(x_pos,y_pos);
end;
end;
procedure dec_mode;
var x_pos,y_pos:integer;
begin
x_pos:=wherex; y_pos:=wherey;
with receiverstat do
begin
remote_on;
if radio_type = 525 then
begin
if mode > RTTY
then mode:=pred(mode)
else mode:=FAX;
end
else { do special case for nrd535 }
begin
case mode of
RTTY: mode:=FAX;
CW: mode:=RTTY;
USB: mode:=CW;
LSB: mode:=USB;
AM: mode:=LSB;
ECSS_USB: mode:=AM;
ECSS_LSB: mode:=ECSS_USB;
FM: mode:=ECSS_LSB;
FAX: mode:=FM;
end;
end;
set_mode(mode);
remote_off(REMOTE_DLY + 100);
if radio_type = 535 then toggle_remote;
show_receiver;
gotoxy(x_pos,y_pos);
end;
end;
procedure inc_bandwidth;
begin
with receiverstat do
begin
remote_on;
bandwidth:=succ(bandwidth);
set_bandwidth(bandwidth);
remote_off(REMOTE_DLY);
if radio_type = 535 then toggle_remote;
show_receiver;
end;
end;
procedure dec_bandwidth;
begin
with receiverstat do
begin
remote_on;
bandwidth:=pred(bandwidth);
set_bandwidth(bandwidth);
remote_off(REMOTE_DLY);
if radio_type = 535 then toggle_remote;
show_receiver;
end;
end;
procedure do_kiwa; { different mode if KIWA MAP unit in use }
var freq,offset:real;
x_pos,y_pos:integer;
begin
x_pos:=wherex; y_pos:=wherey;
map:=not map; {toggle mode}
with receiverstat do
begin
if map then {enable mode}
begin
if mode = USB then offset:=MAP_OFFSET else offset:=-MAP_OFFSET;
remote_on;
set_mode(AM);
mode:=AM;
set_bandwidth(WIDE);
bandwidth:=WIDE;
set_agc(FAST);
agc:=FAST;
frequency:=trunc(frequency / 5.0 + 0.5) * 5.0 + offset;
set_freq(frequency);
remote_off(REMOTE_DLY);
end
else
begin
remote_on;
freq:=frequency;
frequency:=trunc(frequency / 5.0 + 0.5) * 5.0;
set_freq(frequency);
if frequency < freq then
begin
set_mode(USB);
mode:=USB;
end
else
begin
set_mode(LSB);
mode:=LSB;
end;
set_bandwidth(INTER);
bandwidth:=INTER;
end;
remote_off(REMOTE_DLY);
end;
show_receiver;
gotoxy(x_pos,y_pos);
end;
procedure do_confirm;
{ refresh database time and date and receiver status }
var recnum:integer;
tlog,logdata:logtype;
t_begin, t_end, t_now, dummy:integer;
ch:char;
s:string;
begin
x_pos:=wherex; y_pos:=wherey;
{ get receiver status }
if radio_type = 525 then remote_on
else
begin
toggle_remote;
if async_buffer_check(ch) then check_status(s);
end;
show_receiver;
remote_off(0);
recnum:=rec - 1;
if precess(recnum, y_pos) then
begin
clear_log(tlog);
get_log(logbuf,logdata,recdata.recptr[recnum]);
write_prompt('Confirm: Type "y" to continue');
ch:=upcase(fetch);
cmd_prompt(prompt_num);
if ch = 'Y' then
begin
logdata.date:=tlog.date;
val(tlog.begin_time,t_now,dummy);
val(logdata.begin_time,t_begin,dummy);
val(logdata.end_time,t_end,dummy);
t_begin:=t_begin - t_now;
if t_begin < 0 then t_begin:=t_begin + 2400;
t_end:=t_now - t_end;
if t_end < 0 then t_end:=t_end + 2400;
if t_begin < t_end
then if t_begin < 1200 then logdata.begin_time:=tlog.begin_time;
if t_end < t_begin
then if t_end < 1200 then logdata.end_time:=tlog.begin_time;
with receiverstat do
begin
if not map then {don't update receiver params if using map}
begin
logdata.frequency:=frequency;
logdata.mode:=mode;
logdata.agc:=agc;
logdata.attenuator:=attenuator;
logdata.bandwidth:=bandwidth;
end;
end;
put_log(logbuf,logdata,recdata.recptr[recnum]);
end;
end;
bottom_window;
show_log(rec,TRUE,TRUE);
end;
procedure do_write; { as in dudley... }
{ copy record at cursor in inactive log to current log }
var x_pos,y_pos:integer;
t,recnum:integer;
ch:char;
i,j:integer;
dummy:boolean;
begin
if last_log = 0 then exit;
x_pos:=wherex; y_pos:=wherey;
recnum:=rec - 1;
dummy:=precess(recnum,y_pos);
i:=1;
while (i < records) and (recdata.recstat[recdata.recptr[i]] <> DELETED)
do inc(i);
if (i >= records) and (recdata.recstat[recdata.recptr[i]]<>DELETED) then
{ insert new entry here }
begin
inc(records);
i:=records;
recdata.recptr[i]:=i;
loglist.log[loglist.currentlog].records:=records;
put_loglist(loglist);
end;
t:=recdata.recptr[i];
if recnum = 0 then recnum:=1; { special case for new arrays }
for j:=i downto recnum + 1 do with recdata do
recptr[j]:=recptr[j - 1];
recdata.recptr[recnum]:=t;
recdata.recstat[t]:=SHOW;
put_log(logbuf,last_log_data,recdata.recptr[recnum]);
put_recdata(loglist.currentlog,recdata);
if display_page <> 1 then
begin
display_page:=1;
draw_display_titles;
bottom_window;
end;
gotoxy(x_pos,y_pos);
show_log(rec,TRUE,TRUE);
end;
procedure do_pageup(cnt:byte);
var i,j:integer;
begin
x_pos:=wherex; y_pos:=LINES - REC_WIN_Y_BOTTOM - 1;
gotoxy(x_pos,y_pos);
for j:=1 to cnt do
begin
for i:=1 to LINES - REC_WIN_Y_BOTTOM + 1 do
begin
if rec > 1 then rec:=rec - 1;
while (rec > 1) and (recdata.recstat[recdata.recptr[rec]]
<> SHOW) do
rec:=rec - 1;
end;
end;
if rslt = 0 then show_log(rec,TRUE,TRUE);
end;
procedure do_pagedown(cnt:byte);
var i:integer;
begin
x_pos:=wherex; y_pos:=1;
gotoxy(x_pos,y_pos);
for i:=1 to cnt do
if precess(rec, LINES - REC_WIN_Y_BOTTOM - 1) then
if rec > records then rec:=records;
if rslt = 0 then show_log(rec,TRUE,TRUE);
end;
procedure do_up;
begin
x_pos:=wherex; y_pos:=wherey;
y_pos:=y_pos - 1;
if y_pos < 1 then
begin
y_pos:=1;
if rec > 1 then rec:=rec - 1;
while (rec > 1) and (recdata.recstat[rec] <> SHOW) do
rec:=rec - 1;
if rslt = 0 then show_log(rec,TRUE,TRUE);
end
else
begin
show_log(rec,FALSE,FALSE);
gotoxy(x_pos,y_pos);
show_log(rec,FALSE,TRUE);
end;
end;
procedure do_down;
var dummy:boolean;
begin
x_pos:=wherex; y_pos:=wherey;
inc(y_pos);
if y_pos > LINES - REC_WIN_Y_BOTTOM - 1 then
begin
y_pos:=LINES - REC_WIN_Y_BOTTOM - 1;
dummy:=precess(rec,1);
if rec > records then rec:=records;
if rslt = 0 then show_log(rec,TRUE,TRUE);
end
else
begin
show_log(rec,FALSE,FALSE);
gotoxy(x_pos,y_pos);
show_log(rec,FALSE,TRUE);
end;
end;
procedure do_right;
begin
x_pos:=wherex; y_pos:=wherey;
inc(x_pos);
if x_pos > CHARPERLINE then
begin
x_pos:=1;
inc(display_page);
if display_page > 3 then display_page:=1;
draw_display_titles;
bottom_window;
if rslt = 0 then show_log(rec,TRUE,TRUE);
end;
gotoxy(x_pos,y_pos);
end;
procedure do_left;
begin
x_pos:=wherex; y_pos:=wherey;
x_pos:=x_pos - 1;
if x_pos < 1 then
begin
x_pos:=CHARPERLINE;
display_page:=display_page - 1;
if display_page < 1 then display_page:=3;
draw_display_titles;
bottom_window;
if rslt = 0 then show_log(rec,TRUE,TRUE);
end;
gotoxy(x_pos,y_pos);
end;
procedure do_home;
begin
rec:=1; x_pos:=1; y_pos:=1;
gotoxy(x_pos,y_pos);
show_log(rec,TRUE,TRUE);
end;
procedure do_end;
begin
rec:=records; x_pos:=1; y_pos:=1;
do_pagedown(1);
end;
procedure new_log(lognum:byte; var rslt:integer);
begin
open_log(logbuf,lognum, rslt);
get_recdata(lognum, recdata);
records:=loglist.log[lognum].records;
rec:=loglist.log[lognum].rec;
end;
procedure do_alternate;
var i:integer;
recnum:integer;
t_begin, t_end, t_now, dummy:integer;
begin
x_pos:=wherex; y_pos:=wherey;
recnum:=rec - 1;
sync_loglist;
if last_log > 0 then
begin
new_log(loglist.currentlog,rslt);
if precess(recnum, y_pos) then
get_log(logbuf,last_log_data,recdata.recptr[recnum]);
i:=last_log;
last_log:=loglist.currentlog;
loglist.currentlog:=i;
put_loglist(loglist);
do_unmark(FALSE);
close(logbuf);
end;
status_window;
bottom_window;
get_loglist(loglist);
new_log(loglist.currentlog,rslt);
x_pos:=1; y_pos:=1;
gotoxy(x_pos,y_pos);
show_log(rec,TRUE,TRUE);
end;
procedure do_journal;
var ch:char;
new:byte;
procedure clr_prompt;
begin
gotoxy(1,2); clreol;
end;
procedure do_select(s:string; var new:byte);
var found,dummy1,dummy2:boolean;
i:integer;
ch:char;
t,t1:string;
begin
repeat
clr_prompt;
write(output,'Enter log NAME ',s,' (Enter for none):');
t:='';
editfield(47,1,6,FALSE,dummy1,dummy2,t);
t:=upcasestr(t);
{ search for duplicate }
found:=FALSE;
i:=0;
while (i < MAXLOGS) and not found do
begin
inc(i);
with loglist.log[i] do if t = logname then found:=TRUE;
end;
if not found and (t[1] <> ' ') then
begin
clr_prompt;
write(output,'Log not found <SPACE> to continue:');
ch:=fetch;
clr_prompt;
end;
until found or (t[1] = ' ');
if not found then i:=loglist.currentlog;
new:=i;
clr_prompt;
end;
procedure do_create;
var i:integer;
s:short_str;
dummy1,dummy2,found:boolean;
ch:char;
begin
s:='';
repeat
clr_prompt;
write('Enter new log name: ');
editfield(22,1,6,FALSE,dummy1,dummy2,s);
s:=upcasestr(s);
{ search for duplicate }
found:=FALSE;
for i:=1 to MAXLOGS do
if s = upcasestr(loglist.log[i].logname) then found:=TRUE;
if found then
begin
clr_prompt;
write(output,s,': Duplicate log name <SPACE> to continue:');
ch:=fetch;
clr_prompt;
end;
until not found;
{ add name if not full }
i:=0;
while (i < MAXLOGS) and not found do
begin
i:=i + 1;
if loglist.log[i].logname = '' then
begin
found:=TRUE;
with loglist.log[i] do
begin
logname:=s;
records:=0;
rec:=1;
end;
inc(loglist.logcount);
put_loglist(loglist);
end;
end;
if not found then
begin
clr_prompt;
write(output,'Maximum number of logs exist <SPACE> to cont:');
ch:=fetch;
clr_prompt;
end;
end;
procedure do_import;
const db_name1 = 'SWSKED';
procedure import(s:string);
var found:boolean;
rslt,i,j:integer;
end_found:boolean;
procedure move_db(logcnt:integer; var rslt:integer);
var f:file;
ch:char;
i:integer;
logdat:logtype;
function read_file(chars:integer):string;
var buf:array[1..255] of char;
s:string;
i:integer;
begin
rslt:=ioresult;
s:='';
if rslt <> 0 then read_file:=' '
else
begin
blockread(f,buf,chars);
for i:=1 to chars do s:=s + upcase(buf[i]);
read_file:=s;
end;
end;
procedure strip_header;
var buf:array[1..610] of char;
begin
{ strip off first 610 characters and discard }
blockread(f,buf,610);
rslt:=ioresult;
end;
procedure get_entry(logcnt:integer);
var logdat: logtype;
freqs:array[1..10] of real;
comments:array[1..10] of string[COMMENTLEN];
i:integer;
procedure get_location;
var s:string;
i:integer;
test:boolean;
function str_compare(s1,s2:string):boolean;
var i:integer;
match:boolean;
begin
match:=length(s1) = length(s2);
if match then for i:=1 to length(s1) do
if match then match:= s1[i] = s2[i];
str_compare:=match;
end;
begin
s:=read_file(20);
end_found:= pos(chr(26),s) <> 0;
while length(s) < LOCATIONLEN do s:=s + ' ';
logdat.location:=s;
end;
procedure get_station_id;
var s:string;
begin
s:=read_file(24);
while length(s) < CALLSIGNLEN do s:=s + ' ';
logdat.callsign:=s;
end;
procedure get_start_time;
begin
logdat.begin_time:=read_file(4);
end;
procedure get_end_time;
begin
logdat.end_time:=read_file(4);
end;
function get_freq:real;
var freq:real;
i:integer;
s:string;
begin
freq:=0.0;
s:=read_file(5);
for i:=1 to 5 do
begin
if (s[i] in ['0'..'9'])
then freq:=freq * 10 + (ord(s[i]) - ord('0'));
end;
get_freq:=freq;
end;
procedure get_comment;
var s:string;
i:integer;
ch:char;
procedure parse_comment(var s:string);
var num1,num2,i,j:integer;
ch,separator:char;
s1,cmd:string;
found:boolean;
procedure get_num(var s:string; var num:integer);
var i:integer;
found:boolean;
begin
num:=0;
found:=FALSE;
while not found do
begin
num:=num * 10 + ord(s[1]) - ord('0');
delete(s,1,1);
found:=(s = '') or not (s[1] in ['0'..'9']);
end;
end;
procedure get_next_comment(var str:string);
var i:integer;
begin
i:=pos('#',s) - 1;
if i<=0 then i:=length(s);
str:=copy(s,1,i);
delete(s,1,i);
end;
procedure do_range; { case: #n-m }
var i:integer;
str:string;
begin
get_next_comment(str);
for i:=num1 to num2 do comments[i]:=comments[i] + str;
{ handle case #m-n,o,... }
if cmd <> '' then while cmd[1] = ',' do
begin
delete(cmd,1,1);
get_num(cmd,num1);
comments[num1]:=comments[num1] + str;
end;
end;
procedure do_list; { case: #n,o,p...}
var i:integer;
str:string;
begin
get_next_comment(str);
comments[num1]:=comments[num1] + str;
comments[num2]:=comments[num2] + str;
if cmd <> '' then while cmd[1] = ',' do
begin
delete(cmd,1,1);
get_num(cmd,num1);
comments[num1]:=comments[num1] + str;
end;
end;
procedure do_entry; { case: #n }
var str:string;
begin
get_next_comment(str);
comments[num1]:=comments[num1] + str;
end;
procedure do_both; { case: #n&m }
var i:integer;
str:string;
begin
get_next_comment(str);
comments[num1]:=comments[num1] + str;
comments[num2]:=comments[num2] + str;
if cmd <> '' then while cmd[1] = '&' do
begin
delete(cmd,1,1);
get_num(cmd,num1);
comments[num1]:=comments[num1] + str;
end;
end;
begin { parse comment }
{ check for comment unique to entries }
i:=pos('#',s);
if i = 0 then i:=length(s) + 1;
{ copy message up to command to each comment }
s1:=copy(s,1,i - 1);
for j:=1 to 10 do comments[j]:=comments[j] + s1;
{ get comments unique to entry eg #4&5 }
cmd:='';
j:=i + 1;
found:=FALSE;
while (j < length(s)) and not found do
begin
found:=s[j] in [' ','#'];
if not found then
begin
cmd:=cmd + s[j];
inc(j);
end;
end;
delete(s,1,j - 1);
{ decode unique comments and assign }
{ known formats: #n, #n&m, #n,m,...,#n-m }
get_num(cmd,num1);
if cmd <> '' then
begin
separator:=cmd[1];
delete(cmd,1,1);
get_num(cmd,num2);
end;
case separator of
'-': do_range;
'&': do_both;
',': do_list;
else do_entry;
end;
end;
begin { get_comment }
for i:=1 to 10 do comments[i]:='';
s:='Target:' + read_file(40);
{ parse comments for individual entries }
while length(s) > 0 do parse_comment(s);
for i:=1 to 10 do while length(comments[i]) < COMMENTLEN do
comments[i]:=comments[i] + ' ';
end;
procedure get_date;
var s:string;
begin
s:=read_file(2); { discard decade ie 19 }
logdat.date:=read_file(6);
end;
procedure skip;
var dummy:string;
begin
dummy:=read_file(9);
end;
begin { get_entry }
{ set variables that won't change for the duration }
with logdat do
begin
agc:=FAST;
mode:=USB;
bandwidth:=INTER;
end;
get_location;
if end_found then exit;
get_station_id;
get_start_time;
get_end_time;
for i:=1 to 10 do freqs[i]:=get_freq;
get_comment;
get_date;
skip;
for i:=1 to 10 do
begin
if freqs[i] <> 0.0 then
begin
with loglist.log[logcnt] do
begin
inc(records);
write(output,'.');
if records < MAXREC then
begin
logdat.comment:=comments[i];
logdat.frequency:=freqs[i];
put_log(logbuf,logdat,records);
end;
end;
end;
end;
end;
begin { move_db }
assign(f,PATH+S+'.DBF');
reset(f,1);
rslt:=ioresult;
if rslt <> 0 then
begin
writeln(output,
'Must have ',PATH+S+'.DBF in directory to import');
hndlerr(TRUE,ch,rslt);
exit;
end;
strip_header;
home;
write(output,'Reading / parsing database');
end_found:=false;
while (rslt = 0) and not end_found do get_entry(logcnt);
close(f);
records:=loglist.log[loglist.currentlog].records;
for i:=1 to MAXREC do
begin
recdata.recptr[i]:=i;
recdata.recstat[i]:=SHOW;
end;
put_recdata(loglist.currentlog,recdata);
put_loglist(loglist);
rslt:=0;
end;
procedure eliminate_dups(lognum:integer);
{ collapse entries with time overlap }
var rec1ptr,i,j,t,rslt:integer;
logdata1,logdata2:logtype;
begin
home;
write(output,'Crunching duplicate entries');
get_log(logbuf,logdata1,recdata.recptr[1]);
rec1ptr:=1;
i:=2;
while (i < loglist.log[lognum].records) do
begin
if recdata.recstat[recdata.recptr[i]] = DELETED then exit;
get_log(logbuf,logdata2,recdata.recptr[i]);
write(output,'.');
if (logdata2.frequency = logdata1.frequency) and
(logdata2.begin_time = logdata1.end_time) and
(logdata2.comment = logdata1.comment) and
(logdata2.location = logdata1.location) and
(logdata2.callsign = logdata1.callsign) then
begin
logdata1.end_time:=logdata2.end_time;
put_log(logbuf,logdata1,recdata.recptr[rec1ptr]);
t:=recdata.recptr[i];
recdata.recstat[t]:=DELETED;
for j:=i to records - 1 do with recdata do
recptr[j]:=recptr[j + 1];
recdata.recptr[records]:=t;
end
else { no match }
begin
logdata1:=logdata2;
rec1ptr:=i;
inc(i);
end;
end;
end;
begin { import }
found:=FALSE;
i:=0;
while not found and (i < MAXLOGS) do
begin
inc(i);
if s = upcasestr(loglist.log[i].logname) then found:=TRUE;
end;
if found then
begin
with loglist.log[i] do
begin
logname:=s;
records:=0;
rec:=1;
end;
end
else { add name if not full }
begin
i:=0;
while (i < MAXLOGS) and not found do
begin
i:=i + 1;
if loglist.log[i].logname = '' then
begin
found:=TRUE;
inc(loglist.logcount);
put_loglist(loglist);
end;
end;
if not found then
begin
clr_prompt;
write(output,'Maximum number of logs exist <SPACE> to cont:');
ch:=fetch;
clr_prompt;
exit;
end;
with loglist.log[i] do
begin
logname:=s;
records:=0;
rec:=1;
end;
end;
loglist.currentlog:=i;
open_log(logbuf,i,rslt);
move_db(i,rslt);
if rslt = 0 then
begin
home;
do_sort(TRUE);
eliminate_dups(i);
put_recdata(loglist.currentlog,recdata);
end;
close(logbuf);
end;
begin
import(db_name1);
end;
procedure do_delete;
var i:integer;
s,s1:short_str;
dummy1,dummy2,found:boolean;
ch:char;
f:file;
begin
clr_prompt; s:='';
write('Enter log to DELETE: ');
editfield(22,1,6,FALSE,dummy1,dummy2,s);
s:=upcasestr(s);
{ search for entry }
found:=FALSE;
i:=0;
while (i < MAXLOGS) and not found do
begin
inc(i);
if s = upcasestr(loglist.log[i].logname) then found:=TRUE;
end;
if found then
begin
clr_prompt;
write(output,'DELETE ',s,'?');
ch:=upcase(fetch);
clr_prompt;
if ch = 'Y' then
begin
loglist.log[i].logname:='';
loglist.log[i].records:=0;
loglist.log[i].rec:=0;
loglist.logcount:=loglist.logcount - 1;
put_loglist(loglist);
str(i,s1);
if length(s1) = 1 then s1:='0' + s1;
s1:=s1 + '.DAT';
assign(f,PATH + RECDATAFILE + s1);
erase(f);
assign(f,PATH + LOGFILE + s1);
erase(f);
end;
end;
end;
procedure display_logs;
var i,j,k,deletions:integer;
t:string;
recdata:recdatatype;
begin
gotoxy(1,4);
call_crt(ERASEOS);
j:=0;
for i:=1 to MAXLOGS do
begin
t:=loglist.log[i].logname;
if t <> '' then { display it }
begin
inc(j);
deletions:=0;
get_recdata(i,recdata);
for k:=1 to loglist.log[i].records do
if recdata.recstat[k] = DELETED then inc(deletions);
writeln(output,j:3,' ',t,' ',loglist.log[i].records
- deletions);
end;
end;
end;
procedure move_record(marked, move:boolean; dest, from:byte);
var x_pos,y_pos:integer;
t,recnum:integer;
ch:char;
i,j:integer;
dummy:boolean;
logdata:logtype;
to_recdata,from_recdata:recdatatype;
found:boolean;
from_buf,to_buf:file;
function get_logentry(i:integer;var logdata:logtype):boolean;
var found:boolean;
j,k,l:integer;
begin
found:=TRUE;
j:=from_recdata.recptr[i];
if marked then found:=(i >=min_mark) and (i <=max_mark);
found:=found and (from_recdata.recstat[j] = SHOW);
if found then
begin
get_log(from_buf,logdata,j);
if move then { delete old entry }
from_recdata.recstat[j]:=DELETED;
end;
get_logentry:=found;
end;
procedure put_logentry(var i:integer; logdata:logtype);
var j:integer;
begin
while (i < loglist.log[dest].records)
and (to_recdata.recstat[to_recdata.recptr[i]] <> DELETED)
do inc(i);
if (i >= loglist.log[dest].records)
and (to_recdata.recstat[to_recdata.recptr[i]] <> DELETED) then
{ insert new entry here }
begin
inc(loglist.log[dest].records);
i:=loglist.log[dest].records;
to_recdata.recptr[i]:=i;
if recnum = 0 then recnum:=1;
end;
t:=to_recdata.recptr[i];
for j:=i downto recnum + 1 do with to_recdata do
recptr[j]:=recptr[j - 1];
to_recdata.recptr[recnum]:=t;
to_recdata.recstat[t]:=SHOW;
put_log(to_buf,logdata,to_recdata.recptr[recnum]);
inc(recnum);
end;
procedure push_delete;
{ push deleted records to the end of the chain }
var i,j,k,last:integer;
begin
last:=loglist.log[from].records;
for i:=1 to last do
begin
j:=from_recdata.recptr[i];
if from_recdata.recstat[j] = DELETED then
begin
for k:=i to last - 1 do
from_recdata.recptr[k]:=from_recdata.recptr[k + 1];
from_recdata.recptr[last]:=j;
end;
end;
end;
begin {move_record }
recnum:=loglist.log[dest].rec;
get_recdata(from,from_recdata);
get_recdata(dest,to_recdata);
open_log(from_buf,from,rslt); if rslt > 0 then exit;
open_log(to_buf,dest,rslt); if rslt > 0 then exit;
j:=1;
for i:=1 to loglist.log[from].records do
begin
found:=get_logentry(i,logdata);
if found then put_logentry(j,logdata);
end;
if move then push_delete;
close(to_buf);
close(from_buf);
put_recdata(dest,to_recdata);
put_recdata(from,from_recdata);
put_loglist(loglist);
end;
procedure do_the_write;
var dest:byte;
begin
do_select('to write to',dest);
move_record(TRUE,FALSE,dest,loglist.currentlog);
end;
procedure do_move;
var dest:byte;
begin
do_select('to move to',dest);
move_record(TRUE,TRUE,dest,loglist.currentlog);
do_unmark(FALSE);
end;
procedure do_print;
const LINESPERPAGE = 60;
var pbuf:text;
i,cnt:integer;
dummy:boolean;
logdata:logtype;
s:short_str;
s1:string;
logbuf:file;
rslt:integer;
procedure printhdr;
begin
write(pbuf,'Num Date Strt End Freq '+
'Station ID Location');
writeln(pbuf,'Comment':22,'Md':35,' BW');
cnt:=1;
end;
begin
assign(pbuf,'LPT1');
rewrite(pbuf);
write(pbuf,chr(27),'g'); { compressed mode }
printhdr;
i:=0;
open_log(logbuf,loglist.currentlog,rslt);
while (i < records) do
begin
dummy:=precess(i,1);
get_log(logbuf,logdata,recdata.recptr[i]);
if (i >= min_mark) and (i <= max_mark) then
begin
inc(cnt);
if cnt > LINESPERPAGE then
begin
write(pbuf,chr(12)); { form feed }
printhdr;
end;
with logdata do
begin
write(pbuf,i:4,date:DATELEN + 1,begin_time:TIMELEN + 1);
write(pbuf,end_time:TIMELEN + 1);
write(pbuf,frequency:9:2,callsign:CALLSIGNLEN + 1);
s1:=copy(location,1,22);
while length(s1) < 22 do s1:=s1 + ' ';
write(pbuf,s1:23);
s1:=copy(comment,1,39);
while length(s1) < 39 do s1:=s1 + ' ';
write(pbuf,s1:40);
case mode of
RTTY: s:='RT';
CW: s:='CW';
USB: s:='UB';
LSB: s:='LB';
AM: s:='AM';
FM: s:='FM';
FAX: s:='FX';
ECSS_USB: s:='Eu';
ECSS_LSB: s:='El';
end;
write(pbuf,s:3);
case bandwidth of
NARR: s:='NR';
INTER: s:='IN';
WIDE: s:='WD';
AUX: s:='AX';
end;
writeln(pbuf,s:3);
end;
end;
end;
close(pbuf);
close(logbuf);
end;
begin
sync_loglist;
close(logbuf);
repeat
write_prompt('Journal: '+
'S(elect, C(reate, D(el, I(mport, W(rite, M(ove, P(rint, Q(uit');
bottom_window;
home;
display_logs;
ch:=upcase(fetch);
case ch of
'S': begin
do_select('to switch to',new);
last_log:=new;
if loglist.currentlog = last_log then last_log:=0;
put_loglist(loglist);
cmd_prompt(prompt_num);
do_alternate;
exit;
end;
'C': do_create;
'D': do_delete;
'W': do_the_write;
'M': do_move;
'P': do_print;
'I': do_import;
end;
until (ch = 'Q');
cmd_prompt(prompt_num);
bottom_window;
get_loglist(loglist);
new_log(loglist.currentlog,rslt);
x_pos:=1; y_pos:=1;
gotoxy(x_pos,y_pos);
show_log(rec,TRUE,TRUE);
end;
procedure call_do_help;
begin
do_help;
show_log(rec,TRUE,TRUE);
end;
procedure check_s_meter(var reading:integer);
var s:string;
s_reading, dummy:integer;
begin
reading:=1;
write_com(COM_NRD,'H1'); { lock radio; cmd mode }
if async_buffer_check(ch) then comreadln(COM_NRD,s); { discard }
write_com(COM_NRD,'M'); { request s-meter reading }
write_com(COM_NRD,'H0'); { unlock radio }
comreadln(COM_NRD,s);
write_com(COM_NRD,'I1');
if s[1] = 'M' then { got a valid s-meter reading }
begin
delete(s,1,1);
val(s,s_reading,dummy);
case s_reading of { map to dB }
255..245: reading:=-9;
244..233: reading:=-8;
232..221: reading:=-7;
220..209: reading:=-6;
208..198: reading:=-5;
197..186: reading:=-4;
185..174: reading:=-3;
173..163: reading:=-2;
162..155: reading:=-1;
154..163: reading:=1;
142..155: reading:=2;
133..143: reading:=3;
124..134: reading:=4;
118..125: reading:=5;
112..119: reading:=6;
108..113: reading:=7;
103..109: reading:=8;
99..104: reading:=9;
92.. 98: reading:=10;
90.. 91: reading:=15;
87.. 89: reading:=20;
84.. 86: reading:=25;
81.. 83: reading:=30;
78.. 80: reading:=35;
75.. 77: reading:=40;
73.. 74: reading:=45;
72.. 72: reading:=50;
70.. 71: reading:=55;
0.. 69: reading:=60;
else reading:=1;
end;
end;
end;
procedure timed_s_meter;
var reading:integer;
hour,minute,sec,sec100:word;
begin
x_pos:=wherex; y_pos:=wherey;
if radio_type <> 535 then exit;
gettime(hour,minute,sec,sec100);
time_stamp:=sec;
if (time_stamp <> old_time_stamp) then
begin
old_time_stamp:=time_stamp;
check_s_meter(reading);
top_window;
gotoxy(42,3);
writea(LIGHTGRAY,FOREGROUND);
write(output,'S-Meter:');
if (reading > 9)
then writea(RED,FOREGROUND)
else writea(CYAN,FOREGROUND);
write(output,reading:2);
bottom_window;
end;
end;
procedure init_crt;
begin
home;
init_rec_window;
update_receiver_display:=TRUE;
status_window;
bottom_window;
end;
procedure graph_init;
var graphdriver:integer;
errorcode:integer;
begin
if radio_type = 525 then exit;
graphdriver:=detect;
case graphdriver of
CGA: graphmode:=CGAHI;
MCGA: graphmode:=MCGAHI;
EGA: graphmode:=EGAHI;
EGA64: graphmode:=EGA64HI;
EGAMONO: graphmode:=EGAMONOHI;
IBM8514: graphmode:=IBM8514HI;
HERCMONO:graphmode:=HERCMONOHI;
ATT400: graphmode:=ATT400HI;
VGA: graphmode:=VGAHI;
PC3270: graphmode:=PC3270HI;
end;
initgraph(graphdriver,graphmode,'');
errorcode:=graphresult;
if errorcode <> grok then exit;
restorecrtmode;
home;
end;
procedure do_graph;
const X_INIT = 40;
Y_INIT = 100;
SCALE = 2.2;
Y_SCALE = 480;
X_SCALE = 640;
X_AXIS = X_INIT - 5;
type plottype = (NONE, TIME, SPECTRAL);
var count:integer;
reading:integer;
dummy:integer;
max_x,max_y:integer;
max_count:integer;
hour,minute,sec,sec100:word;
last_plot:plottype;
ch:char;
start_freq, stop_freq:real;
function scale_y(reading:integer):integer;
begin
scale_y:=round((reading * SCALE - Y_INIT) * max_y / Y_SCALE);
end;
procedure init_graph;
var y:integer;
procedure draw_tick(reading:integer; db:string);
var y:integer;
begin
y:=scale_y(reading);
moveto(X_AXIS-2,y);
lineto(X_AXIS+5,y);
setcolor(8);
lineto(max_x,y);
setcolor(15);
moveto(X_AXIS-30,y-3);
outtext(db);
end;
begin
setgraphmode(graphmode);
moveto(X_AXIS,scale_y(240));
lineto(X_AXIS,scale_y(60));
draw_tick(67,'');
draw_tick(71,'+50');
draw_tick(75,'');
draw_tick(81,'+30');
draw_tick(87,'');
draw_tick(92,'+10');
draw_tick(99,'+9');
draw_tick(108,'+7');
draw_tick(118,'+5');
draw_tick(133,'+3');
draw_tick(154,'+1');
end;
function get_s_reading:integer;
var s,s1:string;
ch:char;
reading:integer;
freq:real;
begin
repeat
write_com(COM_NRD,'M'); { request s-meter reading }
comreadln(COM_NRD,s);
ch:=s[1];
delete(s,1,1);
if ch = 'M' then val(s,reading,dummy);
until ch = 'M';
get_s_reading:=reading;
end;
procedure plot_title(s:string);
begin
setfillstyle(1,0);
bar(100,18,max_x,25);
moveto(((max_x - length(s)) div 2) - 25,18);
outtext(S);
end;
procedure clear_prompt;
begin
setfillstyle(1,0);
bar(1,1,max_x,8);
setcolor(2);
moveto(1,1);
end;
procedure out_prompt(s:string);
begin
clear_prompt;
outtext(s);
setcolor(15);
end;
procedure main_prompt;
begin
out_prompt('GRAPHICS: C(lear, T(ime plot, S(pectral plot, Q(uit');
end;
procedure time_plot;
var ch:char;
begin
out_prompt('Hit <SPACE BAR> to stop');
setfillstyle(1,0);
bar(1,scale_y(238),getmaxx,scale_y(260));
plot_title('T I M E P L O T');
count:=0;
write_com(COM_NRD,'H1'); { lock radio; cmd mode }
reading:=get_s_reading;
moveto(X_INIT,scale_y(reading));
setcolor(11);
while not keypressed do
begin
gettime(hour,minute,sec,sec100);
time_stamp:=sec;
if (time_stamp <> old_time_stamp) then
begin
old_time_stamp:=time_stamp;
inc(count);
end;
reading:=get_s_reading;
lineto(X_INIT + count, scale_y(reading));
if count > max_count then
begin
count:=0;
moveto(X_INIT,scale_y(reading));
end;
end;
main_prompt;
ch:=fetch; { get key pressed and discard }
end;
procedure spectral_plot;
const BUFFERSIZE = 100;
PLOTBUFSIZE = 1024;
var ok,nullval:boolean;
start,stop:integer;
delta:real;
last_freq, freq:real;
freq_range:real;
count_delta,count:integer;
i:integer;
s:string;
freq_buffer: array[1..BUFFERSIZE] of byte;
plot_buffer, plot_cnt: array[0..PLOTBUFSIZE] of byte;
old_stat:receivertype;
ch:char;
procedure draw_x_axis;
const POINTS = 8;
var i,x:integer;
del:real;
s:string;
f:real;
begin
moveto(X_AXIS,scale_y(240));
lineto(max_x, scale_y(240));
del:=max_count / POINTS;
for i:=0 to POINTS do
begin
x:=round(X_AXIS + del * i);
moveto(x, scale_y(242));
lineto(x, scale_y(238));
moveto(x - 26, scale_y(250));
f:=start_freq + i * ((stop_freq - start_freq) / POINTS);
str(f:7:1,s);
outtext(s);
end;
end;
procedure radio_setup;
var s:string;
begin
old_stat:=receiverstat;
write_com(COM_NRD,'H1'); { lock radio; cmd mode }
set_mode(CW);
set_bandwidth(INTER);
write_com(COM_NRD,'W0500'); { set bw to 500hz }
if freq_range <= 100.0 then s:='1' else s:='2';
write_com(COM_NRD,'V' + s); { control tuning increment }
set_agc(FAST);
set_freq(start_freq);
delay(200);
write_com(COM_NRD,'H0');
end;
procedure get_scan_range;
begin
start:=round(start_freq);
str(start_freq:5:0,s);
s:='starting frequency [default=' + s + ']';
entnum(1,5,start,ok,nullval,s);
if not ok then exit;
if not nullval then start_freq:=start;
stop:=round(stop_freq);
str(stop_freq:5:0,s);
s:='stopping frequency [default=' + s + ']';
entnum(1,7,stop,ok,nullval,s);
if not ok then exit;
if not nullval then stop_freq:=stop;
end;
procedure restore_radio; { to settings prior to spectral plot }
begin
remote_on;
write_com(COM_NRD,'W2400'); { set bw to 2400hz }
with receiverstat do
set_all(199,attenuator,bandwidth,mode,frequency,agc);
write_com(COM_NRD,'V0');
write_com(COM_NRD,'H0'); { unlock radio }
delay(REMOTE_DLY);
end;
procedure plot_point(freq:real;y:byte);
var x,ave:integer;
color:integer;
begin
{ adaptively Kalman filter reading to get statistical average }
{ the idea is to end up with a running average where the last }
{ point has no more influence than the first }
x:=round(max_count * ((freq - start_freq) / freq_range));
ave:=round((plot_cnt[x] * plot_buffer[x] + y) / (plot_cnt[x] + 1));
plot_buffer[x]:=ave;
if plot_cnt[x] < 255 then inc(plot_cnt[x]);
{ now draw point }
if y < 99 then color:=12 else color:=11;
putpixel(x + X_AXIS,scale_y(y),color);
end;
procedure draw_average;
var x:integer;
begin
moveto(X_AXIS,scale_y(plot_buffer[0]));
setcolor(14);
for x:=1 to max_count do if plot_buffer[x] > 0 then
lineto(x + X_AXIS,scale_y(plot_buffer[x]));
end;
procedure init_spectral_plot;
begin
init_graph;
out_prompt('COMMANDS: A(verage, C(lear, Q(uit');
plot_title('S P E C T R A L P L O T');
draw_x_axis;
end;
begin
restorecrtmode;
home;
writea(LIGHTGREEN,FOREGROUND);
writeln(output, ' SPECTRAL PLOT: Enter the frequency range to scan');
get_scan_range;
init_spectral_plot;
freq_range:=stop_freq - start_freq;
radio_setup;
{ init plot statistics used to Kalman filter averages }
for i:=0 to max_count do
begin
plot_buffer[i]:=0;
plot_cnt[i]:=0;
end;
last_freq:=start_freq;
ch:=' ';
repeat
remote_on;
delay(200);
count:=0;
write_com(COM_NRD,'Y+');
{ gather data }
while not keypressed and (count < BUFFERSIZE) do
begin
inc(count);
freq_buffer[count]:=get_s_reading;
end;
write_com(COM_NRD,'H0'); { remote_off }
toggle_remote;
delay(300);
if async_buffer_check(ch) then check_status(s); { get frequency }
freq:=receiverstat.frequency;
if freq > stop_freq then
begin
remote_on;
set_freq(start_freq);
delay(200);
end;
write_com(COM_NRD,'H0');
delta:=(freq - last_freq) / BUFFERSIZE;
{ plot buffer contents }
count:=0;
freq:=last_freq;
while (freq < stop_freq) and (count < BUFFERSIZE) do
begin
inc(count);
plot_point(freq, freq_buffer[count]);
freq:=freq + delta;
end;
last_freq:=receiverstat.frequency;
if last_freq > stop_freq then last_freq:=start_freq;
if keypressed then
begin
ch:=upcase(fetch);
case ch of
'A': draw_average;
'C': init_spectral_plot;
end;
end;
until ch = 'Q';
receiverstat:=old_stat;
restore_radio;
main_prompt;
end;
begin
start_freq:=receiverstat.frequency - 5.0;
stop_freq :=receiverstat.frequency + 5.0;
if radio_type <> 535 then exit;
max_x:=getmaxx - 30; max_y:=getmaxy;
max_count:=max_x - X_AXIS;
last_plot:=NONE;
init_graph;
main_prompt;
repeat
if keypressed then ch:=upcase(fetch) else ch:='@' { nop };
case ch of
'@':; { nop }
'C':begin
init_graph;
main_prompt;
end;
'T':time_plot;
'S':spectral_plot;
end;
until ch = 'Q';
restorecrtmode;
init_crt;
write_com(COM_NRD,'H0'); { unlock radio }
comreadln(COM_NRD,s);
write_com(COM_NRD,'I1');
gotoxy(x_pos,y_pos);
show_log(rec,TRUE,TRUE);
end;
begin { nrd }
graph_init;
old_time_stamp:=0;
last_log:=0;
enable_s_meter:=FALSE;
init_com;
if has_map then
begin
remote_on; { get receiver status to see if map is on }
remote_off(0);
map:=receiverstat.mode = AM; { assume MAP in use if radio in AM }
end
else map:=FALSE;
prompt_num:=PAGE1;
get_loglist(loglist);
new_log(loglist.currentlog,rslt);
init_crt;
x_pos:=1; y_pos:=1;
do_unmark(TRUE);
{ init old receiver status to current radio settings }
oldstat:=receiverstat;
if radio_type = 535 then
begin
toggle_remote; { get radio status; dial changes will be cont sent }
show_receiver;
end;
repeat
if (radio_type = 535) and async_buffer_check(ch) then
begin
check_status(s); { they changed dial }
show_receiver;
end;
if enable_s_meter then timed_s_meter;
if update_receiver_display then
begin
if radio_type = 525 then
begin
remote_on;
show_receiver;
remote_off(REMOTE_DLY);
end
else
begin
toggle_remote;
show_receiver;
end;
update_receiver_display:=FALSE;
end;
if keypressed then ch:=upcase(fetch) else ch:='@' { nop };
case ch of
'@':; { nop }
'+': inc_freq;
'-': dec_freq;
'*': find_freq;
'/': begin
if prompt_num = PAGE1 then prompt_num:=PAGE2
else prompt_num:=PAGE1;
cmd_prompt(prompt_num);
bottom_window;
end;
'A': begin
close(logbuf);
do_alternate;
end;
'C': do_confirm;
'P': do_page;
'S': do_sort(FALSE);
'E': do_edit;
'G': do_graph;
'J': do_journal;
'D': do_delete;
'N': do_undelete;
'M': do_mark;
'U': do_unmark(TRUE);
'L': do_log;
'R': begin
enable_s_meter:=not enable_s_meter;
if not enable_s_meter then
begin
top_window;
gotoxy(42,3);
write(output,' ');
bottom_window;
end;
end;
'T': do_tune;
'K': if has_map then do_kiwa;
'W': do_write;
'>': inc_mode;
'.': inc_mode;
'<': dec_mode;
',': dec_mode;
']': inc_bandwidth;
'[': dec_bandwidth;
'H': begin
call_do_help;
status_window;
end;
PAGEUP: do_pageup(1);
PAGEDOWN: do_pagedown(1);
UP: do_up;
DOWN: do_down;
RIGHTARROW: do_right;
LEFTARROW: do_left;
BACKTAB: do_backtab;
TAB: do_tab;
CTRLPAGEUP: do_pageup(10);
CTRLPAGEDN: do_pagedown(10);
HOMEKY: do_home;
ENDKY: do_end;
else update_receiver_display:=TRUE;
end;
until ch = 'Q';
if radio_type = 535 then write_com(COM_NRD,'I0'); { unlock radio }
sync_loglist;
close(logbuf);
window(1,1,80,25);
home;
gotoxy(1,8);
writeln(output,'Send comments and suggestions to:');
writeln(output);
writeln(output,' Tom Whiteside (512) 258-5924');
writeln(output,' 11505 Oak View');
writeln(output,' Austin, TX 78759');
end. { nrd }